home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src / tclXdebug.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-05  |  13.0 KB  |  481 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCLExtend
  3. #endif
  4. /*
  5.  * tclXdebug.c --
  6.  *
  7.  * Tcl command execution trace command.
  8.  *-----------------------------------------------------------------------------
  9.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  10.  *
  11.  * Permission to use, copy, modify, and distribute this software and its
  12.  * documentation for any purpose and without fee is hereby granted, provided
  13.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14.  * Mark Diekhans make no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without express or
  16.  * implied warranty.
  17.  *-----------------------------------------------------------------------------
  18.  * $Id: tclXdebug.c,v 2.6 1993/08/05 06:41:55 markd Exp $
  19.  *-----------------------------------------------------------------------------
  20.  */
  21.  
  22. #include "tclExtdInt.h"
  23.  
  24. /*
  25.  * Client data structure for the cmdtrace command.
  26.  */
  27. #define ARG_TRUNCATE_SIZE 40
  28. #define CMD_TRUNCATE_SIZE 60
  29.  
  30. typedef struct traceInfo_t {
  31.     Tcl_Interp *interp;
  32.     Tcl_Trace   traceHolder;
  33.     int         noEval;
  34.     int         noTruncate;
  35.     int         procCalls;
  36.     int         depth;
  37.     FILE       *filePtr;          /* File to output trace to. */
  38.     } traceInfo_t, *traceInfo_pt;
  39.  
  40. /*
  41.  * Prototypes of internal functions.
  42.  */
  43. static void
  44. PrintStr _ANSI_ARGS_((FILE *filePtr,
  45.                       char *string,
  46.                       int   numChars));
  47.  
  48. static void
  49. PrintArg _ANSI_ARGS_((FILE *filePtr,
  50.                       char *argStr,
  51.                       int   noTruncate));
  52.  
  53. static void
  54. TraceCode  _ANSI_ARGS_((traceInfo_pt traceInfoPtr,
  55.                         int          level,
  56.                         char        *command,
  57.                         int          argc,
  58.                         char       **argv));
  59.  
  60. static void
  61. CmdTraceRoutine _ANSI_ARGS_((ClientData    clientData,
  62.                              Tcl_Interp   *interp,
  63.                              int           level,
  64.                              char         *command,
  65.                              Tcl_CmdProc  *cmdProc,
  66.                              ClientData    cmdClientData,
  67.                              int           argc,
  68.                              char        **argv));
  69.  
  70. static void
  71. DebugCleanUp _ANSI_ARGS_((ClientData  clientData,
  72.                           Tcl_Interp *interp));
  73.  
  74.  
  75. /*
  76.  *-----------------------------------------------------------------------------
  77.  * PrintStr --
  78.  *
  79.  *     Print an string, truncating it to the specified number of characters.
  80.  * If the string contains newlines, \n is substituted.
  81.  *-----------------------------------------------------------------------------
  82.  */
  83. static void
  84. PrintStr (filePtr, string, numChars)
  85.     FILE *filePtr;
  86.     char *string;
  87.     int   numChars;
  88.     {
  89.     int idx;
  90. #ifdef macintosh
  91.     char    savech, savech2, *ptr, *sptr;
  92.     int        (*print_proc)();
  93.     extern int (*Tcl_GetPrintProcedure())();
  94.  
  95.     print_proc = Tcl_GetPrintProcedure();
  96.     
  97.     savech = string[numChars];
  98.     string[numChars] = '\0';
  99.     
  100.     for ( ptr = string ; *ptr ; ++ptr )
  101.         {
  102.         for ( sptr = ptr ; *ptr && *ptr != '\n' && *ptr != '\r' ; ++ptr )
  103.             ;
  104.         if ( ptr > sptr )
  105.             {
  106.             savech2 = *ptr;
  107.             *ptr = '\0';
  108.             
  109.             if (print_proc != NULL && filePtr == stdout)
  110.                 (* print_proc) (sptr);
  111.             else
  112.                 fprintf (filePtr, sptr);
  113.                 
  114.             *ptr = savech2;
  115.             }
  116.         
  117.         if (*ptr == '\0')
  118.             break;
  119.         else
  120.             if (print_proc != NULL && filePtr == stdout)
  121.                 (* print_proc) (" ");
  122.             else
  123.                 fprintf (filePtr, " ");
  124.         }
  125.     
  126.     string[numChars] = savech;
  127.  
  128.     if (numChars < strlen (string))
  129.         if (print_proc != NULL && filePtr == stdout)
  130.             (* print_proc) ("...");
  131.         else
  132.             fprintf (filePtr, "...");
  133. #else
  134.     for (idx = 0; idx < numChars; idx++) {
  135.         if (string [idx] == '\n') {
  136.            putc ('\\', filePtr);
  137.            putc ('n', filePtr);
  138.         } else
  139.            putc (string [idx], filePtr);
  140.     }
  141.     if (numChars < strlen (string))
  142.         fprintf (filePtr, "...");
  143. #endif
  144. }
  145.  
  146. /*
  147.  *-----------------------------------------------------------------------------
  148.  * PrintArg --
  149.  *
  150.  *   Print an argument string, truncating and adding "..." if its longer
  151.  * then ARG_TRUNCATE_SIZE.  If the string contains white spaces, quote
  152.  * it with angle brackets.
  153.  *-----------------------------------------------------------------------------
  154.  */
  155. static void
  156. PrintArg (filePtr, argStr, noTruncate)
  157.     FILE *filePtr;
  158.     char *argStr;
  159.     int   noTruncate;
  160. {
  161.     int idx, argLen, printLen;
  162.     int quote_it;
  163. #ifdef macintosh
  164.     int        (*print_proc)();
  165.     extern int (*Tcl_GetPrintProcedure())();
  166.  
  167.     print_proc = Tcl_GetPrintProcedure();
  168. #endif
  169.  
  170.     argLen = strlen (argStr);
  171.     printLen = argLen;
  172.     if ((!noTruncate) && (printLen > ARG_TRUNCATE_SIZE))
  173.         printLen = ARG_TRUNCATE_SIZE;
  174.  
  175.     quote_it = (printLen == 0);
  176.  
  177.     for (idx = 0; idx < printLen; idx++)
  178.         if (ISSPACE (argStr [idx])) {
  179.             quote_it = TRUE;
  180.             break;
  181.         }
  182.  
  183.     if (quote_it) 
  184. #ifdef macintosh
  185.         if (print_proc != NULL && filePtr == stdout)
  186.             (* print_proc) ("{");
  187.         else
  188. #endif
  189.             putc ('{', filePtr);
  190.         
  191.     PrintStr (filePtr, argStr, printLen);
  192.     
  193.     if (quote_it) 
  194. #ifdef macintosh
  195.         if (print_proc != NULL && filePtr == stdout)
  196.             (* print_proc) ("}");
  197.         else
  198. #endif
  199.             putc ('}', filePtr);
  200. }
  201.  
  202. /*
  203.  *-----------------------------------------------------------------------------
  204.  * TraceCode --
  205.  *
  206.  *   Print out a trace of a code line.  Level is used for indenting
  207.  * and marking lines and may be eval or procedure level.
  208.  *-----------------------------------------------------------------------------
  209.  */
  210. static void
  211. TraceCode (traceInfoPtr, level, command, argc, argv)
  212.     traceInfo_pt traceInfoPtr;
  213.     int          level;
  214.     char        *command;
  215.     int          argc;
  216.     char       **argv;
  217. {
  218.     int idx, cmdLen, printLen;
  219. #ifdef macintosh
  220.     char    buffer[128];
  221.     int        (*print_proc)();
  222.     extern int (*Tcl_GetPrintProcedure())();
  223.  
  224.     print_proc = Tcl_GetPrintProcedure();
  225.  
  226.     sprintf (buffer, "%2d:", level);
  227.     if (print_proc != NULL && traceInfoPtr->filePtr == stdout)
  228.         (* print_proc) (buffer);
  229.     else
  230. #endif
  231.         fprintf (traceInfoPtr->filePtr, "%2d:", level);
  232.  
  233.     if (level > 20)
  234.         level = 20;
  235.     for (idx = 0; idx < level; idx++) 
  236. #ifdef macintosh
  237.         if (print_proc != NULL && traceInfoPtr->filePtr == stdout)
  238.             (* print_proc) ("  ");
  239.         else
  240. #endif
  241.             fprintf (traceInfoPtr->filePtr, "  ");
  242.  
  243.     if (traceInfoPtr->noEval) {
  244.         cmdLen = printLen = strlen (command);
  245.         if ((!traceInfoPtr->noTruncate) && (printLen > CMD_TRUNCATE_SIZE))
  246.             printLen = CMD_TRUNCATE_SIZE;
  247.  
  248.         PrintStr (traceInfoPtr->filePtr, command, printLen);
  249.       } else {
  250.           for (idx = 0; idx < argc; idx++) {
  251.               if (idx > 0)
  252. #ifdef macintosh
  253.                 if (print_proc != NULL && traceInfoPtr->filePtr == stdout)
  254.                     (* print_proc) (" ");
  255.                 else
  256. #endif
  257.                     putc (' ', traceInfoPtr->filePtr);
  258.               PrintArg (traceInfoPtr->filePtr, argv[idx], 
  259.                         traceInfoPtr->noTruncate);
  260.           }
  261.     }
  262.  
  263. #ifdef macintosh
  264.     if (print_proc != NULL && traceInfoPtr->filePtr == stdout)
  265.         (* print_proc) ("\n");
  266.     else
  267. #endif
  268.         putc ('\n', traceInfoPtr->filePtr);
  269.         
  270. #ifdef macintosh
  271.     if (print_proc == NULL || traceInfoPtr->filePtr != stdout)
  272. #endif
  273.         fflush (traceInfoPtr->filePtr);
  274.     }
  275.  
  276. /*
  277.  *-----------------------------------------------------------------------------
  278.  * CmdTraceRoutine --
  279.  *
  280.  *  Routine called by Tcl_Eval to trace a command.
  281.  *-----------------------------------------------------------------------------
  282.  */
  283. static void
  284. CmdTraceRoutine (clientData, interp, level, command, cmdProc, cmdClientData, 
  285.                  argc, argv)
  286.     ClientData    clientData;
  287.     Tcl_Interp   *interp;
  288.     int           level;
  289.     char         *command;
  290.     Tcl_CmdProc  *cmdProc;
  291.     ClientData    cmdClientData;
  292.     int           argc;
  293.     char        **argv;
  294. {
  295.     Interp       *iPtr = (Interp *) interp;
  296.     traceInfo_pt  traceInfoPtr = (traceInfo_pt) clientData;
  297.     int           procLevel;
  298.  
  299.     if (!traceInfoPtr->procCalls) {
  300.         TraceCode (traceInfoPtr, level, command, argc, argv);
  301.     } else {
  302.         if (TclFindProc (iPtr, argv [0]) != NULL) {
  303.             procLevel = (iPtr->varFramePtr == NULL) ? 0 : 
  304.                         iPtr->varFramePtr->level;
  305.             TraceCode (traceInfoPtr, procLevel, command, argc, argv);
  306.         }
  307.     }
  308. }
  309.  
  310. /*
  311.  *-----------------------------------------------------------------------------
  312.  * Tcl_CmdtraceCmd --
  313.  *
  314.  * Implements the TCL trace command:
  315.  *     cmdtrace level|on ?noeval? ?notruncate? ?procs? ?fileid?
  316.  *     cmdtrace off
  317.  *     cmdtrace depth
  318.  *-----------------------------------------------------------------------------
  319.  */
  320. static int
  321. Tcl_CmdtraceCmd (clientData, interp, argc, argv)
  322.     ClientData    clientData;
  323.     Tcl_Interp   *interp;
  324.     int           argc;
  325.     char        **argv;
  326. {
  327.     Interp       *iPtr = (Interp *) interp;
  328.     traceInfo_pt  infoPtr = (traceInfo_pt) clientData;
  329.     int           idx;
  330.     char         *fileHandle;
  331.  
  332.     if (argc < 2)
  333.         goto argumentError;
  334.  
  335.     /*
  336.      * Handle `depth' sub-command.
  337.      */
  338.     if (STREQU (argv[1], "depth")) {
  339.         if (argc != 2)
  340.             goto argumentError;
  341.         sprintf(interp->result, "%d", infoPtr->depth);
  342.         return TCL_OK;
  343.     }
  344.  
  345.     /*
  346.      * If a trace is in progress, delete it now.
  347.      */
  348.     if (infoPtr->traceHolder != NULL) {
  349.         Tcl_DeleteTrace(interp, infoPtr->traceHolder);
  350.         infoPtr->depth = 0;
  351.         infoPtr->traceHolder = NULL;
  352.     }
  353.  
  354.     /*
  355.      * Handle off sub-command.
  356.      */
  357.     if (STREQU (argv[1], "off")) {
  358.         if (argc != 2)
  359.             goto argumentError;
  360.         return TCL_OK;
  361.     }
  362.  
  363.     infoPtr->noEval     = FALSE;
  364.     infoPtr->noTruncate = FALSE;
  365.     infoPtr->procCalls  = FALSE;
  366.     infoPtr->filePtr    = stdout;
  367.     fileHandle          = NULL;
  368.  
  369.     for (idx = 2; idx < argc; idx++) {
  370.         if (STREQU (argv[idx], "notruncate")) {
  371.             if (infoPtr->noTruncate)
  372.                 goto argumentError;
  373.             infoPtr->noTruncate = TRUE;
  374.             continue;
  375.         }
  376.         if (STREQU (argv[idx], "noeval")) {
  377.             if (infoPtr->noEval)
  378.                 goto argumentError;
  379.             infoPtr->noEval = TRUE;
  380.             continue;
  381.         }
  382.         if (STREQU (argv[idx], "procs")) {
  383.             if (infoPtr->procCalls)
  384.                 goto argumentError;
  385.             infoPtr->procCalls = TRUE;
  386.             continue;
  387.         }
  388.         if (STRNEQU (argv [idx], "std", 3) || 
  389.                 STRNEQU (argv [idx], "file", 4)) {
  390.             if (fileHandle != NULL)
  391.                 goto argumentError;
  392.             fileHandle = argv [idx];
  393.             continue;
  394.         }
  395.         goto invalidOption;
  396.     }
  397.  
  398.     if (STREQU (argv[1], "on")) {
  399.         infoPtr->depth = MAXINT;
  400.     } else {
  401.         if (Tcl_GetInt (interp, argv[1], &(infoPtr->depth)) != TCL_OK)
  402.             return TCL_ERROR;
  403.     }
  404.     if (fileHandle != NULL) {
  405.         FILE *filePtr;
  406.  
  407.         if (Tcl_GetOpenFile (interp, fileHandle, 
  408.                              TRUE,   /* Write access */
  409.                              TRUE,   /* Check access */
  410.                              &filePtr) != TCL_OK)
  411.         return TCL_ERROR;
  412.         infoPtr->filePtr = filePtr;
  413.     }
  414.     
  415.     infoPtr->traceHolder = Tcl_CreateTrace (interp, infoPtr->depth,
  416.                                             CmdTraceRoutine,
  417.                                             (ClientData) infoPtr);
  418.     return TCL_OK;
  419.  
  420. argumentError:
  421.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  422.                       " level | on ?noeval? ?notruncate? ?procs?",
  423.                       "?fileid? | off | depth", (char *) NULL);
  424.     return TCL_ERROR;
  425.  
  426. invalidOption:
  427.     Tcl_AppendResult (interp, "invalid option: expected ",
  428.                       "one of \"noeval\", \"notruncate\", \"procs\", ",
  429.                       "or a file id", (char *) NULL);
  430.     return TCL_ERROR;
  431. }
  432.  
  433. /*
  434.  *-----------------------------------------------------------------------------
  435.  * DebugCleanUp --
  436.  *
  437.  *  Release the debug data area when the interpreter is deleted.
  438.  *-----------------------------------------------------------------------------
  439.  */
  440. static void
  441. DebugCleanUp (clientData, interp)
  442.     ClientData  clientData;
  443.     Tcl_Interp *interp;
  444. {
  445.     traceInfo_pt infoPtr = (traceInfo_pt) clientData;
  446.  
  447.     if (infoPtr->traceHolder != NULL)
  448.         Tcl_DeleteTrace (infoPtr->interp, infoPtr->traceHolder);
  449.     ckfree ((char *) infoPtr);
  450. }
  451.  
  452. /*
  453.  *-----------------------------------------------------------------------------
  454.  * Tcl_InitDebug --
  455.  *
  456.  *  Initialize the TCL debugging commands.
  457.  *-----------------------------------------------------------------------------
  458.  */
  459. void
  460. Tcl_InitDebug (interp)
  461.     Tcl_Interp *interp;
  462. {
  463.     traceInfo_pt infoPtr;
  464.  
  465.     infoPtr = (traceInfo_pt) ckalloc (sizeof (traceInfo_t));
  466.  
  467.     infoPtr->interp      = interp;
  468.     infoPtr->traceHolder = NULL;
  469.     infoPtr->noEval      = FALSE;
  470.     infoPtr->noTruncate  = FALSE;
  471.     infoPtr->procCalls   = FALSE;
  472.     infoPtr->depth       = 0;
  473.  
  474.     Tcl_CallWhenDeleted (interp, DebugCleanUp, (ClientData) infoPtr);
  475.  
  476.     Tcl_CreateCommand (interp, "cmdtrace", Tcl_CmdtraceCmd, 
  477.                        (ClientData) infoPtr, (void (*)()) NULL);
  478. }
  479.  
  480.  
  481.